Eagles Nest BBS 8/Eagles_Nest_Mac_Collection_Disc_8.TOAST/Developer Environments/TurPasDBTlbx/TP-Database Toolbox/Turbo Access/TAHigh.unit

Text File | 1987-12-11 | 5.9 KB | 239 lines | [TEXT/TPAS]

(*********************************************************************)
(*                  Turbo Pascal Database Toolbox                    *)
(*                       For the Macintosh                           *)
(*            Copyright (C) 1987 Borland International               *)
(*                     Toolbox version: 1.0                          *)
(*                                                                   *)
(*               TURBO ACCESS HIGH-LEVEL UNIT                        *)
(*                                                                   *)
(*        Purpose: Toolbox of high-Level Turbo Access routines.      *)
(*                 Simplifies programming databases that have        *)
(*                 one data file and one index file.                 *)
(*                                                                   *)
(*        Uses the Turbo Access Unit                                 *)
(*                                                                   *)
(*********************************************************************)
unit TAHigh(8);
interface
{$U-}
{$U TAccess}
uses MemTypes, QuickDraw, OSIntF, ToolIntf, PackIntf, PasInOut, TAccess;

const
{ The following constants can be used to specify search conditions
  for procedure TARead. }
  ExactMatch    = true;
  PartialMatch  = false;

type
  DataSet = record
               Data : DataFile;
               Index : IndexFile;
            end;
var
  TARecNum : LongInt;
{ Number of the last accessed record in the database. You can
  use this variable to build upon the high level calls, say
  by adding a second index file. }


procedure TAClose(var DatSet : DataSet);

procedure TACreate(var DatSet : DataSet;
                   DatFName : string; RecordLen : integer;
                   IndexFName : string; KeyLen : integer);

procedure TADelete(var DatSet : DataSet; var Key);

procedure TAErase(var DatSet : DataSet);

procedure TAInsert(var DatSet : DataSet; var CurRec, Key);

procedure TANext(var DatSet : DataSet; var CurRec, Key);

procedure TAOpen(var DatSet : DataSet;
                 DatFName : string; RecordLen : integer;
                 IndexFName : string; KeyLen : integer);

procedure TAPrev(var DatSet : DataSet; var CurRec, Key);

procedure TARead(var DatSet : DataSet; var CurRec, Key ;
                 FindExact : boolean);

procedure TAReset(var DatSet : DataSet);

procedure TAUpdate(var DatSet : DataSet; var CurRec, Key);

procedure TAWrite(var DatSet : DataSet; var CurRec, Key);

implementation

procedure TAClose{var DatSet : DataSet};
begin
  UserProc := 'TAClose';
  with DatSet do
  begin
    CloseIndex(Index);
    CloseFile(Data);
  end;
  UserProc := '';
end; { TAClose }

procedure TACreate{var DatSet : DataSet;
                   DatFName : string; RecordLen : integer;
                   IndexFName : string; KeyLen : integer};
begin
  UserProc := 'TACreate';
  FillChar(DatSet, SizeOf(DatSet), 0);
  with DatSet do
  begin
    MakeFile(Data, DatFName, RecordLen);
    if Ok then
      MakeIndex(Index, IndexFName, KeyLen, 0);
  end;
  UserProc := '';
end; { TACreate }

procedure TADelete{var DatSet : DataSet; var Key};
begin
  UserProc := 'TADelete';
  with DatSet do
  begin
    FindKey(Index, TARecNum, Key);
    if Ok then
    begin
      DeleteRec(Data, TARecNum);
      DeleteKey(Index, TARecNum, Key);
    end;
  end;
  UserProc := '';
end; { TADelete }

procedure TAErase{var DatSet : DataSet};
begin
  UserProc := 'TAErase';
  with DatSet do
  begin
    EraseIndex(Index);
    EraseFile(Data);
  end;
  UserProc := '';
end; { TAErase }

procedure TAInsert{DatSet : DataSet; var CurRec, Key};
var
  temp : String;
begin
  if UserProc = '' then
    UserProc := 'TAInsert';
  temp := Str255(Key);
  with DatSet do
  begin
    FindKey(Index, TARecNum, temp);
    Ok := not Ok;
    if not Ok then
      Exit;
    AddRec(Data, TARecNum, CurRec);
    AddKey(Index, TARecNum, Key);
  end;
  if UserProc = 'TAInsert' then
    UserProc := '';
end; { TAInsert }

procedure TANext{var DatSet : DataSet; var CurRec, Key};
begin
  UserProc := 'TANext';
  with DatSet do
  begin
    NextKey(Index, TARecNum, Key);
    if Ok then
      GetRec(Data, TARecNum, CurRec);
  end;
  UserProc := '';
end; { TANext }

procedure TAOpen{var DatSet : DataSet;
                 DatFName : string; RecordLen : integer;
                 IndexFName : string; KeyLen : integer};
begin
  UserProc := 'TAOpen';
  FillChar(DatSet, SizeOf(DatSet), 0);
  with DatSet do
  begin
    OpenFile(Data, DatFName, RecordLen);
    if Ok then
      OpenIndex(Index, IndexFName, KeyLen, 0);
  end;
  UserProc := '';
end; { TAOpen }

procedure TAPrev{var DatSet : DataSet; var CurRec, Key};
begin
  UserProc := 'TAPrev';
  with DatSet do
  begin
    PrevKey(Index, TARecNum, Key);
    if Ok then
      GetRec(Data, TARecNum, CurRec);
  end;
  UserProc := '';
end; { TAPrev }

procedure TARead{var DatSet : DataSet; var CurRec, Key ;
                 FindExact : boolean};
var
  S : String;
begin
  UserProc := 'TARead';
  with DatSet do
  begin
    if FindExact then
      FindKey(Index, TARecNum, Key)
    else
    begin
      S := Str255(Key);
      SearchKey(Index, TARecNum, Key);
      if Ok then
        Ok := Pos(S, Str255(Key)) > 0;
    end;
    if Ok then
      GetRec(Data, TARecNum, CurRec);
  end;
  UserProc := '';
end; { TARead }

procedure TAReset{var DatSet : DataSet};
begin
  with DatSet do
    ClearKey(Index);
end; { TAReset }

procedure TAUpdate{var DatSet : DataSet; var CurRec, Key};
begin
  if UserProc = '' then
    UserProc := 'TAUpdate';
  with DatSet do
  begin
    FindKey(Index, TARecNum, Key);
    if Ok then
      PutRec(Data, TARecNum, CurRec);
  end;
  if UserProc = 'TAUpdate' then
    UserProc := '';
end; { TAUpdate }

procedure TAWrite{var DatSet : DataSet; var CurRec, Key};
begin
  UserProc := 'TAWrite';
  with DatSet do
  begin
    TAInsert(DatSet, CurRec, Key);
    if not Ok then
      TAUpdate(DatSet, CurRec, Key);
  end;
  UserProc := '';
end; { TAWrite }

begin
  TARecNum := 0;
end. { TAHigh.unit }